Le projet en science des données représente l’aboutissement du certificat en science des données de l’Université TÉLUQ.Ce projet constitue un complément essentiel de formation pratique et vise à favoriser l’autonomie, l’esprit d’analyse et la rigueur méthodologique dans la conduite d’un projet complet en science des données.
En partenariat avec le Secrétariat à l’Internet haute vitesse et aux projets spéciaux de connectivité du (SIHVPSC) Ministère du Conseil Exécutif 1, le projet présenté ici s’inscrit dans un contexte concret de développement territorial numérique, avec comme objectif principal l’identification de zones d’intérêt prioritaires pour le déploiement de la fibre optique (Internet haute vitesse)2. Ce mandat a permis de mettre en œuvre l’ensemble des compétences développées dans les cours du certificat, notamment :
SCI-1031 : Visualisation et analyse de données spatiales,
SCI-1018 : Statistique avec R,
SCI-1017 : Traitement des données massives,
SCI-1421 : Apprentissage machine.
En croisant des données géospatiales, sociodémographiques et techniques, le projet a exploité des méthodes statistiques, des algorithmes d’apprentissage non supervisé (comme DBSCAN)3 et des outils de traitement de grands volumes de données pour proposer des pistes concrètes d’intervention. L’approche adoptée est fondée sur une démarche rigoureuse : de la collecte des données jusqu’à la communication des résultats, en passant par leur nettoyage, leur exploration et leur modélisation.
Ce projet illustre l’apport stratégique des sciences des données dans la planification d’infrastructures critiques et témoigne du caractère avant-gardiste de la formation offerte dans le cadre du certificat.
L’objectif principal de cette étude est d’identifier des zones d’intérêt prioritaires pour le déploiement de la fibre optique, en analysant la distribution spatiale de points géolocalisés (par exemple, des adresses admissibles à l’Internet haute vitesse). Pour ce faire, nous avons utilisé une approche basée sur la détection de regroupements spatiaux grâce à l’algorithme DBSCAN (Density-Based Spatial Clustering of Applications with Noise), reconnu pour sa capacité à détecter des structures de densité sans supposer un nombre de groupes à l’avance.
Préparation des données Les données sources, composées de coordonnées géographiques en degrés décimaux (latitude/longitude), ont d’abord été nettoyées, géocodées et transformées en objets spatiaux. Cela a permis de faciliter les opérations d’analyse géographique et la visualisation cartographique.
Application de DBSCAN L’algorithme DBSCAN repose sur deux paramètres fondamentaux :
eps, qui représente le rayon maximal autour d’un point pour rechercher des voisins ;
minPts, soit le nombre minimal de points dans ce rayon pour former un regroupement (cluster).
Afin de bien explorer l’espace des paramètres et d’adapter l’algorithme à différents contextes de densité géographique, plusieurs combinaisons de valeurs ont été testées. L’objectif était de faire émerger des regroupements pertinents selon le niveau de concentration des points sur le territoire.
Interprétation des distances Étant donné que les coordonnées sont exprimées en degrés décimaux (ESPG:4326), une conversion approximative en mètres a été effectuée pour mieux interpréter la portée réelle du rayon eps. Aux latitudes du Québec (~46°N), on estime que :
0,01 degré de latitude ≈ 1,11 km (axe nord-sud) ;
0,01 degré de longitude ≈ 0,78 km (axe est-ouest).
Ainsi, un rayon de recherche (eps) de 0,01 correspond à un voisinage spatial d’environ 780 mètres par 1 110 mètres. En augmentant eps à 0,02 ou 0,03, on élargit le périmètre de recherche jusqu’à environ 2,3 km par 3,3 km.
Analyse comparative Chaque combinaison testée de eps et minPts a permis d’observer différentes configurations de regroupements. L’analyse a porté sur plusieurs dimensions :
eps_values <- seq(0.01, 0.06, by = 0.01)
# Approx. des distances en m pour une lat de 46°N
# 1° latitude ≈ 111.32 km
# 1° longitude ≈ 111.32 km × cos(latitude)
lat_m <- 111320 # mètre pour 1° de latitude
lon_m <- 111320 * cos(46 * pi / 180) # mètre pour 1° de longitude à 46°N
# Création du data frame
df_eps_m <- data.frame(
Eps_degre = eps_values,
Distance_NS_m = round(eps_values * lat_m, 0),
Distance_EW_m = round(eps_values * lon_m, 0)
)
colnames(df_eps_m) <- c("Eps (°)", "Distance nord-sud (m)", "Distance est-ouest (m)")
library(knitr)
kable(df_eps_m, caption = "Correspondance entre eps (en degrés) et les distances approximatives en mètres à 46°N")| Eps (°) | Distance nord-sud (m) | Distance est-ouest (m) |
|---|---|---|
| 0.01 | 1113 | 773 |
| 0.02 | 2226 | 1547 |
| 0.03 | 3340 | 2320 |
| 0.04 | 4453 | 3093 |
| 0.05 | 5566 | 3866 |
| 0.06 | 6679 | 4640 |
le nombre de regroupements détectés ;
la proportion de points classés comme bruit (non regroupés) ;
la répartition géographique des clusters, notamment par région administrative.
Cette approche a permis d’identifier les paramètres les plus efficaces pour faire émerger des zones cohérentes et significatives, à fort potentiel pour des projets d’infrastructure numérique.
Voici la liste des adresesses réputées non désservries par une desserte internet haute vitesse. Les données proviennent du SIHVPSC.
# Installer les librairies si nécessaires
if (!require("leaflet")) install.packages("leaflet")
if (!require("sf")) install.packages("sf")
if (!require("dplyr")) install.packages("dplyr")
if (!require("RColorBrewer")) install.packages("RColorBrewer")
library(readr)
library(dplyr)
library(leaflet)
library(sf)
library(RColorBrewer)
# Lire les données
setwd("~/Desktop/Teluq/SCI-1402/Data/")
df <- read.csv("resultat_sf.csv", sep = ",", header = TRUE, encoding = "UTF-8")
# Nettoyer les données
df_clean <- df %>%
filter(!is.na(Longitude), !is.na(Latitude), !is.na(munnom)) %>%
mutate(
Longitude = as.numeric(Longitude),
Latitude = as.numeric(Latitude),
Region_ADM = as.factor(Region_ADM)
)
# Générer une palette de couleurs selon munnom
Region_ADM_levels <- levels(df_clean$Region_ADM)
palette_Region_ADM_levels <- colorFactor(palette = brewer.pal(min(length(Region_ADM_levels), 8), "Set1"), domain = Region_ADM_levels)
carte_reg_adm <- leaflet(df_clean) %>%
addTiles(group = "Base") %>%
addWMSTiles(
baseUrl = "https://servicescarto.mern.gouv.qc.ca/pes/services/Territoire/SDA_WMS/MapServer/WMSServer",
layers = "Région administrative",
options = WMSTileOptions(format = "image/png", transparent = TRUE),
attribution = "© MERN - Gouvernement du Québec",
group = "Contours SDA"
) %>%
addCircleMarkers(
lng = ~Longitude,
lat = ~Latitude,
radius = 4,
color = ~palette_Region_ADM_levels(Region_ADM),
fillOpacity = 0.8,
stroke = FALSE,
label = ~paste0("Municipalité: ", munnom, "<br>Latitude: ", Latitude, "<br>Longitude: ", Longitude)
) %>%
addLegend(
position = "bottomright",
pal = palette_Region_ADM_levels,
values = ~Region_ADM,
title = "Region_ADM",
opacity = 1
)stats_region <- df_clean %>%
filter(!is.na(Region_ADM)) %>%
group_by(Region_ADM) %>%
summarise(
Nombre_points = n()
) %>%
arrange(desc(Nombre_points))
library(kableExtra)
stats_region %>%
kable("html", caption = "Nombre de points par région administrative") %>%
kable_styling(full_width = FALSE, bootstrap_options = c("striped", "hover", "condensed"))| Region_ADM | Nombre_points |
|---|---|
| Outaouais | 6789 |
| Montérégie | 4333 |
| Chaudière-Appalaches | 3768 |
| Laurentides | 3445 |
| Estrie | 3200 |
| Lanaudière | 3129 |
| Saguenay–Lac-Saint-Jean | 3072 |
| Montréal | 2923 |
| Centre-du-Québec | 2322 |
| Capitale-Nationale | 2224 |
| Bas-Saint-Laurent | 2156 |
| Abitibi-Témiscamingue | 1921 |
| Mauricie | 1207 |
| Laval | 882 |
| Côte-Nord | 678 |
| Nord-du-Québec | 651 |
| Gaspésie–Îles-de-la-Madeleine | 359 |
# Lire les centroïdes des régions
df_centroïdes <- read_csv("centroides_regions_quebec.csv")
# Lire le fichier des pourcentages non couverts
df_points <- read_csv("comparatif_points.csv")
# Nettoyer la colonne "pourcentage_non_couvert"
df_points <- df_points %>%
mutate(
pourcentage_non_couvert = as.numeric(gsub("%", "", Pourcentage_non_couvert))
)
# Fusionner sur le code de région
df_merged <- df_centroïdes %>%
left_join(df_points, by = c("Nom" = "Region_ADM"))
# Créer un objet sf à partir des centroïdes
sf_regions <- st_as_sf(df_merged, coords = c("Longitude", "Latitude"), crs = 4326)
# Créer une palette de couleurs rouge → vert (valeur élevée = rouge)
pal <- colorNumeric(
palette = "RdYlGn",
domain = sf_regions$pourcentage_non_couvert,
reverse = TRUE
)
# Créer la carte Leaflet
leaflet(sf_regions) %>%
addProviderTiles("CartoDB.Positron") %>%
addCircleMarkers(
radius = ~sqrt(pourcentage_non_couvert) * 10,
color = ~pal(pourcentage_non_couvert),
stroke = FALSE,
fillOpacity = 0.7,
popup = ~paste0(
"<strong>", Nom, "</strong><br>",
"Pourcentage non couvert : ", round(pourcentage_non_couvert, 1), "%"
)
) %>%
addLegend(
"bottomright",
pal = pal,
values = ~pourcentage_non_couvert,
title = "Pourcentage des adresses non couvertes (%)",
opacity = 0.8
)# Installer les librairies si nécessaires
if (!require("geojsonio")) install.packages("geojsonio")
if (!require("leaflet")) install.packages("leaflet")
if (!require("dbscan")) install.packages("dbscan")
if (!require("sf")) install.packages("sf")
if (!require("dplyr")) install.packages("dplyr")
if (!require("ggplot2")) install.packages("ggplot2")
if (!require("ggforce")) install.packages("ggforce")
if (!require("kableExtra")) install.packages("kableExtra")
library(readr)
library(dplyr)
library(dbscan)
library(leaflet)
library(sf)
library(geojsonio)
library(RColorBrewer)
coords <- df_clean %>%
select(Longitude, Latitude) %>%
as.matrix()
# Paramètres DBSCAN
eps_values <- seq(0.01, 0.03, by = 0.01)
minPts_values <- seq(70, 30, by = -10)
# Créer la carte Leaflet
carte <- leaflet() %>%
addTiles(group = "Base") %>%
addWMSTiles(
baseUrl = "https://servicescarto.mern.gouv.qc.ca/pes/services/Territoire/SDA_WMS/MapServer/WMSServer",
layers = "Région administrative",
options = WMSTileOptions(format = "image/png", transparent = TRUE),
attribution = "© MERN - Gouvernement du Québec",
group = "Contours SDA"
)
# Liste pour garder le nom des groupes
group_names <- c()
# Générer les itérations de clustering
for (eps in eps_values) {
for (minPts in minPts_values) {
label <- sprintf("eps=%.2f_minPts=%d", eps, minPts)
group_names <- c(group_names, label)
# Appliquer DBSCAN
db <- dbscan(coords, eps = eps, minPts = minPts)
df_iter <- df_clean %>%
mutate(cluster = as.factor(db$cluster))
df_iter_grouped <- df_iter %>%
filter(cluster != 0)
# Ajouter le nombre de points par cluster
cluster_counts <- df_iter_grouped %>%
count(cluster, name = "n_points")
df_iter_grouped <- df_iter_grouped %>%
left_join(cluster_counts, by = "cluster")
# Ajouter à la carte dans un groupe spécifique
carte <- carte %>%
addCircleMarkers(
data = df_iter_grouped,
lng = ~Longitude,
lat = ~Latitude,
#color = ~ifelse(cluster == 0, "gray", RColorBrewer::brewer.pal(8, "Set1")[as.integer(cluster)]),
color = ~palette_Region_ADM_levels(Region_ADM),
radius = ~ifelse(cluster == 0, 1, 4),
fillOpacity = 0.8,
stroke = FALSE,
group = label,
label = ~paste("Cluster:", cluster, ": Nb points:", n_points)
)
}
}